home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / comm / wxtrm310.zip / WXTERM.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-11  |  17KB  |  606 lines
  1. PROGRAM wxterm;
  2. {$S-,R-,D+,L+,V-,B+} {3.08}
  3.  
  4. {$M 10240,0,0} {3.09}
  5.  
  6. USES Dos,CRT; {3.05}
  7.   {
  8.   Scott Murphy
  9.   77 So. Adams St. #301
  10.   Denver, CO 80209
  11.   Compuserve 70156,263
  12.  
  13.   Defaults, help screen and hot keys improved.  Ran thru Pascal
  14.   Formatter, changed to a two file program.  Changed to Ver: 3.01
  15.   12-05-87 L.B. Neal, Sunnyvale, CA.
  16.   }
  17. {**************************************************************}
  18. { Jun 1990. Upgraded to Turbo Pascal 5.0/5.5. Ver:3.04         }
  19. { Aug 1991. Corrected several items. New version is 3.05.      }
  20. { Dec 1991. New goodies and StonyBrook support!  3.07          }
  21. { Mar 1992. Fixes and new Goodies!!  New version 3.09          }
  22. { Apr 1992. Fixes and improvements. 3.10                       }
  23. { L.B. Neal, Sunnyvale,CA.                                     }
  24. {**************************************************************}
  25.  
  26. TYPE
  27.   bigstring = STRING[80];     {general purpose}
  28.   Str90 = String[90];         {3.07}
  29.   cset = SET OF 0..127;
  30.   parity_set = (none, even);  {readability and expansion}
  31.  
  32. CONST
  33.   Version = '3.10 ';          { 11-JUN-92 Another look}
  34.   BELL_FREQ = 440;            {frequency for bell sound}
  35.   BELL_DELAY = 100;           {duration of bell sound}
  36.   DEFAULT_BAUD = 9600;        {Serial port speed at start-up}
  37.   RECV_BUF_SIZE = 4097;       {this may be changed to whatever size you need}
  38.   Buffer_End = RECV_BUF_SIZE-1; { safety margin }
  39.   ComPort : Byte = 3;         { I use COM3: }
  40.   WxExit : Boolean = False;  {3.05}
  41.   Cdet: Boolean =  False;   {3.08}
  42.   InitStr:  String[60] = 'AT&C1&D2X4S0=0M0V1Q0'; {3.09}
  43.  
  44. VAR
  45.   AsyncVector: Pointer;
  46.   xtnd: Boolean;
  47.   a: Byte;
  48.   c,i: Integer;
  49.   ch: Char;
  50.   regs: Registers;            { 3.04 }
  51.   INVLIST: Integer;
  52.   Buffer_Head,Buffer_Tail,Buffer_Count: Integer;
  53.   recv_buffer: ARRAY[1..RECV_BUF_SIZE] OF Byte;
  54.  
  55.   speed: Integer;            {I don't know the top speed these
  56.  
  57.                               routines will handle}
  58.   dbits : 7..8;               {only ones most people use}
  59.   stop_bits : 1..2;           {does anyone use 2?}
  60.   parity : parity_set;        {even and none are the common ones}
  61.   Cport: String[4];           {3.04}
  62.   Base: Word;                 {3.04}
  63.   Async_Irq: Word;            {3.04}
  64.   OutPort: Word;              {3.04}
  65.   CdetPort: Word;             {3.07}
  66.   junk: Char;                 {3.04}
  67.   PassStrg: BigString;        {3.04}
  68.   wcol,wrow: Byte;            {3.08}
  69.   fcol,frow: Byte;            {3.09}
  70.  
  71.  {$F+} { MUST be a FAR Procedure 3.04 }
  72.  PROCEDURE async_isr; Interrupt; {$F-} {3.09}
  73.   BEGIN
  74.    Inline($FB); {STI} {3.06}
  75.    Recv_Buffer[Buffer_Head] := Port[Base];
  76.    IF (Buffer_Head = Buffer_End) THEN
  77.     Buffer_Head := 1
  78.    ELSE
  79.     INC(Buffer_Head);
  80.    INC(Buffer_Count);
  81.    Port[$20] := $20;
  82.   END;
  83.  
  84.   PROCEDURE DoBorder(FstCol,FstRow,LstCol,LstRow : Integer; Save:Boolean);
  85.   VAR i,thisrow,width,height,column: Integer; horiz: String[90];
  86.   BEGIN
  87.     IF save THEN wcol := WhereX; wrow := WhereY; {3.08}
  88.     Window(FstCol,FstRow,LstCol,LstRow);
  89.     ClrScr;
  90.     thisrow := 2;
  91.     width := (LstCol-FstCol)-2;
  92.     height := (LstRow-FstRow)-1;
  93.     column := Width+2;
  94.    
  95.     FOR i := 1 to width DO horiz[i] := #205;
  96.     horiz[0] := Char(width);
  97.  
  98.     Gotoxy(1,1); Write(Chr(201));
  99.     Write(horiz);
  100.     Write(Chr(187));
  101.  
  102.     FOR i := 1 TO height DO
  103.      BEGIN
  104.       Gotoxy(1,thisrow);       Write(Chr(186));
  105.       Gotoxy(column,thisrow);  Write(Chr(186));
  106.       INC(thisrow);
  107.      END;
  108.  
  109.     Gotoxy(1,thisrow); Write(CHR(200));
  110.     Write(horiz);
  111.     Write(#188);
  112.   END;
  113.  
  114.   FUNCTION Carrier:Boolean;
  115.   BEGIN
  116.    Carrier := (port[CdetPort] AND 128) <> 0;
  117.   END;
  118.  
  119.   FUNCTION CTS:Boolean; {3.07}
  120.   BEGIN
  121.    Cts := (Port[CdetPort] AND $10) <> 0;
  122.   END;
  123.  
  124.   FUNCTION Wcgetc: Byte; { 3.04 }
  125.   BEGIN
  126.    INLINE($FA); {suspend interrupts}
  127.    wcgetc := Recv_Buffer[buffer_Tail];
  128.    IF Buffer_Tail < Buffer_End THEN { 3.04 safer this way }
  129.     INC(Buffer_Tail)
  130.    ELSE
  131.     Buffer_Tail := 1;
  132.    DEC(Buffer_Count); 
  133.    INLINE($FB); {resume interrupts}
  134.    Port[$20] := $20; {3.05}
  135.   END;
  136.  
  137.   PROCEDURE send(c:Integer); {3.09}
  138.   BEGIN
  139.    (* WHILE NOT Cts DO {NOP}; *)
  140.    WHILE (Port[CdetPort] AND $10) = 0 DO {NOP}; {3.09}
  141.    WHILE (port[outport] AND 32) = 0 DO {NOP};
  142.    port[base] := LO(c); {3.09}
  143.   END;
  144.  
  145.   PROCEDURE sendstr(s:Str90); {3.09 Complete rewrite}
  146.   VAR size,cnt: Byte; ochar: Char; {3.09}
  147.   BEGIN
  148.    size := ORD(s[0]);
  149.    cnt := 1;
  150.    REPEAT
  151.     ochar := s[cnt]; {3.09}
  152.     IF ochar = '~' THEN  {3.09}
  153.      Delay(500)
  154.     ELSE
  155.      BEGIN
  156.       WHILE NOT Cts DO {NOP};
  157.       WHILE (port[outport] AND 32) = 0 DO {NOP};
  158.       port[base] := ORD(ochar);
  159.       Delay(5); {3.08}
  160.      END;
  161.     INC(cnt);
  162.    UNTIL cnt > size;
  163.    port[base] := 13; {3.09}
  164.   END;
  165.  
  166.  PROCEDURE set_baud(r:integer);
  167.  VAR a:byte; rw:word;
  168.  BEGIN
  169.   IF (r >= 300) AND (r <= 9600) THEN
  170.    BEGIN
  171.     CASE r OF {3.07}
  172.      2400: rw := 48;
  173.      1200: rw := 96;
  174.      9600: rw := 12; { 3.07 really 9600 bps }
  175.       300: rw := 384;
  176.     END;
  177.     a := port[base+3] OR 128;
  178.     port[base+3] := a;
  179.     port[base] := lo(rw);
  180.     port[base+1] := hi(rw);
  181.     port[base+3] := a AND 127;
  182.     Delay(500); {3.07 handle slow modems}
  183.    END
  184.   ELSE
  185.    BEGIN
  186.     Writeln('Invalid Baud Rate = ', r); { 2.0i }
  187.     Halt(1);
  188.    END;
  189.  END;
  190.  
  191. procedure dump;
  192. begin
  193.   Inline($FA); {CLI}
  194.   buffer_head := 1;
  195.   buffer_tail := 1;
  196.   buffer_count := 0;
  197.   Inline($FB); {STI}
  198.   Port[$20] := $20; {3.05}
  199. end;
  200.  
  201.  procedure remove_port;
  202.  var i,m : Word;
  203.  begin
  204.   inline($FA); {CLI}
  205.   i := port[$21];
  206.   m := 1 SHL Async_Irq;
  207.   port[$21] := i OR m;
  208.   port[base+2] := 0;
  209.   port[base+4] := port[base+4] AND 1;
  210.   inline($FB); {STI}
  211.   Port[$20] := $20; {3.05}
  212.  end;
  213.  
  214. procedure term_ready(s:Boolean);
  215. var x:byte;
  216. begin
  217.   x := port[base+4] and $FE;
  218.   if s then x := x+1;
  219.   port[base+4] := x;
  220.   Delay(300); {for slow modem 3.07}
  221. end;
  222.  
  223.  PROCEDURE iport1;
  224.   BEGIN
  225.    CASE comport OF
  226.    1 : begin
  227.         base := $3f8; Async_Irq  := 4; cport := 'COM1:';
  228.        end;
  229.    2 : begin
  230.         base := $2f8; Async_Irq  := 3; cport := 'COM2:';
  231.        end;
  232.    3 : begin
  233.         base := $3E8; Async_Irq  := 4; cport := 'COM3:';
  234.        end;
  235.    4 : begin
  236.         base := $2E8; Async_Irq  := 3; cport := 'COM4:';
  237.        end;
  238.    ELSE
  239.     WriteLn('Invalid Comport:',comport);
  240.     Halt(1);
  241.    END; {case}
  242.    outport  := Base+5;
  243.    cdetport := Base+6; {3.07}
  244.   END;
  245.  
  246.   {3.08 NOTE: This needs to be fixed to adjust parity,bits and stopbits!}
  247.   PROCEDURE iport;
  248.   VAR i,m:Integer;
  249.   BEGIN
  250.     buffer_Head := 1;
  251.     buffer_Tail := 1;
  252.     buffer_Count := 0;
  253.     port[base+3]:= $03;
  254.     WITH regs DO
  255.      BEGIN
  256.       ah := $25; al := async_irq+8;
  257.       ds := cseg;
  258.       dx := ofs(async_isr);
  259.       msdos(regs);
  260.      END;
  261.     inline($FA);
  262.     i := port[base+5];
  263.     i := port[base];
  264.     i := port[$21];
  265.     m := (1 shl Async_Irq) xor $00FF;
  266.     port[$21] := i AND m;
  267.     port[base+1] := $01;
  268.     i := port[base+4];
  269.     port[base+4] := i OR $0B;   { 3.07 enable RTS,CTS = $0B;}
  270.     inline($FB);      {3.07}
  271.     Port[$20] := $20; {3.05}
  272.     term_ready(true);
  273.   END;
  274.  
  275.   PROCEDURE break; {send a break}
  276.   VAR a,b: Byte;
  277.   BEGIN
  278.     a := Port[base+3];
  279.     b := (a AND $7F) OR $40;
  280.     Port[base+3] := b;
  281.     Delay(750);
  282.     Port[base+3] := a;
  283.   END;
  284.  
  285.   FUNCTION exists(fname:bigstring): Boolean;
  286.   VAR f: FILE;
  287.   BEGIN
  288.    Assign(f, fname);
  289.    {$I-} Reset(f); {$I+}
  290.    IF IOResult = 0 THEN
  291.     BEGIN
  292.      exists := True;
  293.      Close(f);
  294.     END
  295.    ELSE
  296.     exists := False
  297.   END;
  298.  
  299.   {This is really interesting and educational too!!!}
  300.   {NOTE: This does deserve some study!!  3.09}
  301.  
  302.   PROCEDURE supcase(VAR s);
  303.   VAR ss:bigstring ABSOLUTE s; i,size:Byte;
  304.   BEGIN
  305.    {size := length(ss);} {3.09}
  306.    size := ORD(ss[0]); {3.09}
  307.    {FOR i := 1 TO size DO ss[i] := UpCase(ss[i]);} {3.09}
  308.    i := 1;
  309.    REPEAT
  310.     ss[i] := Upcase(ss[i]);
  311.     INC(i);
  312.    UNTIL i > size;
  313.   END;
  314.  
  315.   PROCEDURE processcom;
  316.   VAR c,cnt: Byte;
  317.   BEGIN
  318.    IF Buffer_Count > 0 THEN {